home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1999 #2 / Amiga Plus CD - 1999 - No. 2.iso / System-Boost / Grafik / picFX / e-source / parser.e next >
Text File  |  1998-11-08  |  41KB  |  1,248 lines
  1. OPT MODULE
  2.  
  3. MODULE 'tools/longreal'
  4. MODULE 'dos/dos',
  5.        'exec/nodes','exec/ports','exec/semaphores','exec/tasks',
  6.        'graphics/rastport','cybergraphics','picasso96api'
  7.  
  8. OBJECT function
  9.     precision        -> OUT_#?
  10.     type             -> the type of function, FTYPE_#?
  11.     args:PTR TO LONG -> May be of different types, see below.
  12.     constant:CHAR    -> TRUE if the function does not depend on x.
  13.     value:LONG       -> value of the constant if constant is true (or longreal address)
  14.     nofree           -> set to TRUE if the program don't want value to be freed by end()
  15.     warning          -> warning messages, when using functions that will not work.
  16. ENDOBJECT
  17.  
  18. EXPORT SET  WARN_Trig,
  19.             WARN_Mod
  20.  
  21. EXPORT OBJECT project_Node
  22.     ln:ln   -> base node structure
  23.     window  -> window object
  24.     item    -> string that appears in opened_lst
  25.     pid     -> Project ID
  26. ENDOBJECT
  27.  
  28. EXPORT OBJECT subtaskmsg
  29.    stm_Message:mn
  30.    stm_Command:INT
  31.    stm_Parameter:LONG
  32.    stm_Result:LONG
  33. ENDOBJECT
  34.  
  35. EXPORT OBJECT subtask
  36.   st_Task:PTR TO tc      /* sub task pointer */
  37.   st_Port:PTR TO mp      /* allocated by sub task */
  38.   st_Reply:PTR TO mp     /* allocated by main task */
  39.   st_Data:LONG           /* more initial data to pass to the sub task */
  40.   st_Message:subtaskmsg  /* Message buffer */
  41. ENDOBJECT
  42.  
  43. EXPORT OBJECT planeFunc_data
  44.     projectid -> Project ID, used when referencing a project from "outside"
  45.                         /***attributes storage***/
  46.     bfunc:PTR TO function
  47.     bstr:PTR TO CHAR
  48.     failure                    /*$RGB*/
  49.     gfunc:PTR TO function
  50.     gstr:PTR TO CHAR
  51.     height:PTR TO function
  52.     imagefile:PTR TO CHAR
  53.     left,newleft                ->scroll when newleft is non-zero
  54.     loading
  55.     loadm
  56.     lock -> -1 when there's a writelock, 0 when it is free, number of readlocks otherwise
  57.     name:PTR TO CHAR
  58.     overflowhandling
  59.     projectnode:PTR TO project_Node
  60.     rfunc:PTR TO function
  61.     rstr:PTR TO CHAR
  62.     paused -> this is used by the 'state' attribute, with the 'lock' var
  63.     outputr,outputg,outputb
  64.     quiet
  65.     top,newtop                  -> scroll when newtop is non-zero
  66.     type
  67.     width
  68.                         /***some pointers...***/
  69.     hscroll,vscroll         -> scrollers of the window
  70.     app                     -> pointer to application
  71.     self                    -> pointer to ourselves
  72.                         /***some useful data***/
  73.     savepixel               -> true if the previous pixel must be saved
  74.     sema:ss                 -> data item protection
  75.     subtask:PTR TO subtask  -> our sub task
  76.     rp:PTR TO rastport      -> rastport for the sub task
  77.     drawn                   -> the last line that has been drawn to the window
  78.     calculated              -> the last line that has been calculated by the subtask
  79.     ds:datestamp            -> planeFunc stores the datestamp when a calculation is started
  80. ENDOBJECT
  81.  
  82. EXPORT ENUM OUT_Integer=0, -> 32bits integer
  83.             OUT_Float32, -> 32Bits float
  84.             OUT_Float64,  -> 64Bits float
  85.             OUT_OldR,OUT_OldG,OUT_OldB, -> Components of the pixel (previous calculation!)
  86.             OUT_CopyR,OUT_CopyG          -> Copies the new expression (e.g. black'n'white)
  87.  
  88. ENUM FTYPE_None=0, -> When empty
  89.     FTYPE_Constant, -> args = the value of that constant or a PTR TO longreal
  90.     FTYPE_Variable, -> args=VAR_.. or CTE_..
  91.     FTYPE_Plus,FTYPE_Substr,FTYPE_Multiply,FTYPE_Divide, -> args = two pointers to two function or variable
  92.     FTYPE_Power, -> args = two pointers to two functions or variable
  93.     FTYPE_Mod,FTYPE_Max,FTYPE_Min,
  94. /*Some single argument functions: args directely holds the address of the related function*/
  95.     FTYPE_Sin,FTYPE_Cos,FTYPE_Tan, /*trigonometric..*/
  96.     FTYPE_ASin,FTYPE_ACos,FTYPE_ATan,/*their inverses*/
  97. /*three functions to get the value of another planeFunc object*/
  98.     FTYPE_Red,FTYPE_Green,FTYPE_Blue -> args = one LONG and two PTR TO function
  99.  
  100. DEF farray:PTR TO LONG /*Global (but private) variable containing the addresses of the operators.*/
  101. DEF gtd, -> gtd is the address of the getdata(dat,num) PROC
  102.     dat  -> dat is the address of the ProjectlistObject's data
  103.  
  104. ENUM GR_Red=0,GR_Green,GR_Blue
  105.  
  106. CONST VAR_x=-1,
  107.     VAR_y=-2,
  108.     CTE_e=-3,
  109.     CTE_pi=-4
  110.  
  111. EXPORT PROC initfuncs(gtda,data,picasso)
  112.     IF farray THEN END farray[FTYPE_Blue+1] -> Being called by the setup method of the main program,
  113.     NEW farray[FTYPE_Blue+1]                -> This function risks being called twice or more times.
  114.     farray[FTYPE_None]:={enone}
  115.     farray[FTYPE_Constant]:={econst}
  116.     farray[FTYPE_Variable]:={evar}
  117.     farray[FTYPE_Plus]:={eplus}
  118.     farray[FTYPE_Substr]:={esubstr}
  119.     farray[FTYPE_Multiply]:={emultiply}
  120.     farray[FTYPE_Divide]:={edivide}
  121.     farray[FTYPE_Power]:={epower}
  122.     farray[FTYPE_Mod]:={emod}
  123.     farray[FTYPE_Max]:={emax}
  124.     farray[FTYPE_Min]:={emin}
  125.     farray[FTYPE_Sin]:={esin}
  126.     farray[FTYPE_Cos]:={ecos}
  127.     farray[FTYPE_Tan]:={etan}
  128.     farray[FTYPE_ASin]:={easin}
  129.     farray[FTYPE_ACos]:={eacos}
  130.     farray[FTYPE_ATan]:={eatan}
  131.     IF picasso
  132.         farray[FTYPE_Red]:={pred}
  133.         farray[FTYPE_Green]:={pgreen}
  134.         farray[FTYPE_Blue]:={pblue}
  135.     ELSE
  136.         farray[FTYPE_Red]:={ered}
  137.         farray[FTYPE_Green]:={egreen}
  138.         farray[FTYPE_Blue]:={eblue}
  139.     ENDIF
  140.     gtd:=gtda
  141.     dat:=data
  142. ENDPROC
  143.  
  144. EXPORT PROC cleanfuncs() /*executed at the end of the caller program (e.g. within EXCEPT ENDPROC)*/
  145.     END farray[FTYPE_Blue+1]
  146. ENDPROC
  147.  
  148. PROC decode(str:PTR TO CHAR,start=0,end=-1,modl=FALSE) OF function HANDLE
  149. DEF tstr:PTR TO CHAR,f:function -> to pass a method to a variable, e.g. self.args[1]
  150. DEF k:PTR TO LONG,lr:PTR TO longreal
  151. DEF  pos /*the index of the current operator*/,        pri  /*its priority*/,  type /*its type*/,
  152.     bpos /*the index of the less important operator*/,bpri=5/*its priority*/, btype /*its type*/
  153.  
  154.     self.nofree:=TRUE
  155.     self.end() -> remove the memory allocated in {args}, if necessary, but keeps the function structure.
  156.     self.nofree:=FALSE
  157.  
  158.     IF end=-1 THEN end:=StrLen(str)-1
  159.  
  160.     pos:=start-1
  161.     LOOP
  162.         pos,type:=sep(str,pos+1)
  163.         IF CtrlC() THEN Raise(126)
  164.         IF pos > end THEN JUMP out
  165.         pri:=priority(type)
  166.         IF pri <= bpri
  167.             bpos:=pos
  168.             bpri:=pri
  169.             btype:=type
  170.         ENDIF
  171.     ENDLOOP
  172. out:
  173.     self.constant:=FALSE -> default state
  174.     IF bpri = 5 -> no operators
  175.         tstr:=String(end-start+2)
  176.         MidStr(tstr,str,start,end-start+1) /*it is probably not necessary to write the length again*/
  177.         IF StrCmp(tstr,'x')
  178.             self.type:=farray[FTYPE_Variable]
  179.             self.args:=VAR_x
  180.         ELSEIF StrCmp(tstr,'y')
  181.             self.type:=farray[FTYPE_Variable]
  182.             self.args:=VAR_y
  183.             self.constant:=TRUE
  184.         ELSEIF StrCmp(tstr,'pi')
  185.             self.type:=farray[FTYPE_Variable]
  186.             self.args:=CTE_pi
  187.             self.constant:=TRUE
  188.         ELSEIF StrCmp(tstr,'e')
  189.             self.type:=farray[FTYPE_Variable]
  190.             self.args:=CTE_e
  191.             self.constant:=TRUE
  192.         ELSEIF StrCmp(tstr,'r',1)
  193.             self.type:=farray[FTYPE_Red]
  194.             NEW k[3]
  195.             self.args:=k
  196.             pos:=findcomma(str,start+2)
  197.             IF pos=-1                      /*(This is quite silly:-) If there is a mistake,*/
  198.                 NEW f.create(self.precision) /*Raise. The functions are created so that end()*/
  199.                 k[1]:=f                      /*can END them without trouble.*/
  200.                 NEW f.create(self.precision)
  201.                 k[2]:=f
  202.                 Raise(-1)
  203.             ENDIF
  204.             k[]:=gtd(dat,Val(str+start+2))
  205.             NEW f.create(self.precision)
  206.             k[1]:=f
  207.             bpos:=findcomma(str,pos+1)
  208.             IF (bpos=-1) OR (k[]=0) -> no second comma or unexistant ID
  209.                 NEW f.create(self.precision)
  210.                 k[2]:=f
  211.                 Raise(-1)
  212.             ENDIF
  213.             f.decode(str,pos+1,bpos-1,TRUE)
  214.             NEW f.create(self.precision)
  215.             k[2]:=f
  216.             pos:=bpos
  217.             bpos:=end
  218.             f.decode(str,pos+1,bpos-1,TRUE)
  219.         ELSEIF StrCmp(tstr,'g',1)
  220.             self.type:=farray[FTYPE_Green]
  221.             NEW k[3]
  222.             self.args:=k
  223.             pos:=findcomma(str,start+2)
  224.             IF pos=-1
  225.                 NEW f.create(self.precision)
  226.                 k[1]:=f
  227.                 NEW f.create(self.precision)
  228.                 k[2]:=f
  229.                 Raise(-1)
  230.             ENDIF
  231.             k[]:=gtd(dat,Val(str+start+2))
  232.             NEW f.create(self.precision)
  233.             k[1]:=f
  234.             bpos:=findcomma(str,pos+1)
  235.             IF (bpos=-1) OR (k[]=0)
  236.                 NEW f.create(self.precision)
  237.                 k[2]:=f
  238.                 Raise(-1)
  239.             ENDIF
  240.             f.decode(str,pos+1,bpos-1,TRUE)
  241.             NEW f.create(self.precision)
  242.             k[2]:=f
  243.             pos:=bpos
  244.             bpos:=end
  245.             f.decode(str,pos+1,bpos-1,TRUE)
  246.         ELSEIF StrCmp(tstr,'b',1)
  247.             self.type:=farray[FTYPE_Blue]
  248.             NEW k[3]
  249.             self.args:=k
  250.             pos:=findcomma(str,start+2)
  251.             IF pos=-1
  252.                 NEW f.create(self.precision)
  253.                 k[1]:=f
  254.                 NEW f.create(self.precision)
  255.                 k[2]:=f
  256.                 Raise(-1)
  257.             ENDIF
  258.             k[]:=gtd(dat,Val(str+start+2))
  259.             NEW f.create(self.precision)
  260.             k[1]:=f
  261.             bpos:=findcomma(str,pos+1)
  262.             IF (bpos=-1) OR (k[]=0)
  263.                 NEW f.create(self.precision)
  264.                 k[2]:=f
  265.                 Raise(-1)
  266.             ENDIF
  267.             f.decode(str,pos+1,bpos-1,TRUE)
  268.             NEW f.create(self.precision)
  269.             k[2]:=f
  270.             pos:=bpos
  271.             bpos:=end
  272.             f.decode(str,pos+1,bpos-1,TRUE)
  273.         ELSEIF StrCmp(tstr,'mod',3)
  274.             self.type:=farray[FTYPE_Mod]
  275.             NEW k[2]
  276.             self.args:=k
  277.             NEW f.create(self.precision)
  278.             self.args[]:=f
  279.             pos:=findcomma(str,start+4)
  280.             IF pos = -1
  281.                 NEW f.create(self.precision)
  282.                 self.args[1]:=f
  283.                 Raise(-1)
  284.             ENDIF
  285.             f.decode(str,start+4,pos-1,TRUE)
  286.             self.constant:=f.constant
  287.             NEW f.create(self.precision)
  288.             self.args[1]:=f
  289.             f.decode(str,pos+1,end-1,TRUE)
  290.             self.constant:=self.constant AND f.constant
  291.         ELSEIF StrCmp(tstr,'min',3)
  292.             self.type:=farray[FTYPE_Min]
  293.             NEW k[2]
  294.             self.args:=k
  295.             NEW f.create(self.precision)
  296.             self.args[]:=f
  297.             pos:=findcomma(str,start+4)
  298.             IF pos = -1
  299.                 NEW f.create(self.precision)
  300.                 self.args[1]:=f
  301.                 Raise(-1)
  302.             ENDIF
  303.             f.decode(str,start+4,pos-1,TRUE)
  304.             self.constant:=f.constant
  305.             NEW f.create(self.precision)
  306.             self.args[1]:=f
  307.             f.decode(str,pos+1,end-1,TRUE)
  308.             self.constant:=self.constant AND f.constant
  309.         ELSEIF StrCmp(tstr,'max',3)
  310.             self.type:=farray[FTYPE_Max]
  311.             NEW k[2]
  312.             self.args:=k
  313.             NEW f.create(self.precision)
  314.             self.args[]:=f
  315.             pos:=findcomma(str,start+4)
  316.             IF pos = -1
  317.                 NEW f.create(self.precision)
  318.                 self.args[1]:=f
  319.                 Raise(-1)
  320.             ENDIF
  321.             f.decode(str,start+4,pos-1,TRUE)
  322.             self.constant:=f.constant
  323.             NEW f.create(self.precision)
  324.             self.args[1]:=f
  325.             f.decode(str,pos+1,end-1,TRUE)
  326.             self.constant:=self.constant AND f.constant
  327.         ELSEIF StrCmp(tstr,'asin',4)
  328.             self.type:=farray[FTYPE_ASin]
  329.             NEW f.create(self.precision)
  330.             self.args:=f
  331.             f.decode(str,start+5,end-1,TRUE)
  332.             self.constant:=f.constant
  333.         ELSEIF StrCmp(tstr,'acos',4)
  334.             self.type:=farray[FTYPE_ACos]
  335.             NEW f.create(self.precision)
  336.             self.args:=f
  337.             f.decode(str,start+5,end-1,TRUE)
  338.             self.constant:=f.constant
  339.         ELSEIF StrCmp(tstr,'atan',4)
  340.             self.type:=farray[FTYPE_ATan]
  341.             NEW f.create(self.precision)
  342.             self.args:=f
  343.             f.decode(str,start+5,end-1,TRUE)
  344.             self.constant:=f.constant
  345.         ELSEIF StrCmp(tstr,'sin',3)
  346.             self.type:=farray[FTYPE_Sin]
  347.             NEW f.create(self.precision)
  348.             self.args:=f
  349.             f.decode(str,start+4,end-1,TRUE)
  350.             self.constant:=f.constant
  351.         ELSEIF StrCmp(tstr,'cos',3)
  352.             self.type:=farray[FTYPE_Cos]
  353.             NEW f.create(self.precision)
  354.             self.args:=f
  355.             f.decode(str,start+4,end-1,TRUE)
  356.             self.constant:=f.constant
  357.         ELSEIF StrCmp(tstr,'tan',3)
  358.             self.type:=farray[FTYPE_Tan]
  359.             NEW f.create(self.precision)
  360.             self.args:=f
  361.             f.decode(str,start+4,end-1,TRUE)
  362.             self.constant:=f.constant
  363.         ELSEIF tstr[]="("
  364.             self.decode(str,start+1,end-1,modl) -> just decode what is within the brackets
  365.         ELSE
  366.             self.type:=farray[FTYPE_Constant]
  367.             IF (tstr[] < "0") OR (tstr[] > "9") THEN Raise(-1)
  368.             self.constant:=TRUE
  369.             IF self.precision=OUT_Integer
  370.                 self.args:=Val(tstr)
  371.                 self.value:=self.args
  372.             ELSEIF self.precision=OUT_Float32
  373.                 self.args:=RealVal(tstr)
  374.                 self.value:=self.args
  375.             ELSEIF self.precision=OUT_Float64
  376.                 NEW lr
  377.                 self.args:=lr
  378.                 a2d(tstr,lr)
  379.                 dCopy(self.value,self.args)
  380.             ENDIF
  381.         ENDIF
  382.         DisposeLink(tstr)
  383.     ELSE
  384.         self.type:=farray[btype]
  385.         NEW k[2]
  386.         self.args := k
  387.         NEW f.create(self.precision)
  388.         self.args[0]:=f
  389.         f.decode(str,start,bpos-1,TRUE)
  390.         self.constant:=f.constant
  391.         NEW f.create(self.precision)
  392.         self.args[1]:=f
  393.         f.decode(str,bpos+1,end,TRUE)
  394.         self.constant:=self.constant AND f.constant -> only if both args are constant, self will be constant.
  395.     ENDIF
  396. EXCEPT
  397.     self.end()
  398.     IF modl -> Another .decode() called us, so call it's Exception handler
  399.         Raise(-1)
  400.     ELSE    -> this .decode() has been called from picFX. don't call it's Exception handler but return TRUE.
  401.         RETURN TRUE
  402.     ENDIF
  403. ENDPROC FALSE
  404.  
  405. PROC priority(type)
  406.     IF type <= FTYPE_Substr; RETURN 1            /*  + - : 1  */
  407.     ELSEIF type <= FTYPE_Divide; RETURN 2       /*  * / : 2  */
  408.     ELSEIF type = FTYPE_Power; RETURN 3         /*   ^  : 3  */
  409.     ELSE ; RETURN 4
  410.     ENDIF
  411. ENDPROC
  412. PROC sep(str:PTR TO CHAR,start)
  413. DEF q,r,f,p
  414.     p:=InStr(str,'(',start)
  415.     r:=StrLen(str)
  416.     IF p=-1 THEN p:=r+1
  417.     IF (q:=InStr(str,'+',start)) <> -1
  418.         r:=q;f:=FTYPE_Plus
  419.     ENDIF
  420.     IF ((q:=InStr(str,'-',start)) <> -1) AND (q < r)
  421.         r:=q;f:=FTYPE_Substr
  422.     ENDIF
  423.     IF ((q:=InStr(str,'*',start)) <> -1) AND (q < r)
  424.         r:=q;f:=FTYPE_Multiply
  425.     ENDIF
  426.     IF ((q:=InStr(str,'/',start)) <> -1) AND (q < r)
  427.         r:=q;f:=FTYPE_Divide
  428.     ENDIF
  429.     IF ((q:=InStr(str,'^',start)) <> -1) AND (q < r)
  430.         r:=q;f:=FTYPE_Power
  431.     ENDIF
  432.     IF r > p THEN r,f:=sep(str,findclose(str,p))
  433. ENDPROC r,f
  434.  
  435. PROC findclose(str:PTR TO CHAR,open)
  436. DEF a,b
  437.     a:=InStr(str,'(',open+1)       /*a is the first ( */
  438.     IF a=-1 THEN a:=StrLen(str)
  439.     b:=InStr(str,')',open+1)       /*b is the first ) */
  440.     IF b=-1 THEN Raise(-1)
  441.     IF b < a THEN RETURN b         /*If the first ) is before the first ( , then return the former*/
  442.     b:=findclose(str,a)             /*else: first find when the first ( closes...*/
  443.     RETURN findclose(str,b)         /*...and then search for the next )*/
  444. ENDPROC
  445.  
  446. PROC findcomma(str:PTR TO CHAR,start)
  447. DEF a,b
  448.     a:=InStr(str,',',start+1)
  449.     b:=InStr(str,'(',start+1)
  450.     IF (b = -1) OR (b > a) THEN -> No parhenthesis bothering before that comma
  451.         RETURN a
  452. ENDPROC findcomma(str,findclose(str,b))
  453.  
  454. PROC reference() OF function
  455.     IF (self.type=farray[FTYPE_Red]) OR
  456.        (self.type=farray[FTYPE_Green]) OR
  457.        (self.type=farray[FTYPE_Blue]) THEN
  458.  
  459.         RETURN self.args[0],self.args[1],self.args[2]
  460.  
  461.  
  462.     IF self.type <= farray[FTYPE_Variable] THEN
  463.         RETURN 1,NIL,NIL
  464.  
  465.     IF self.type <= farray[FTYPE_Min] THEN
  466.         RETURN 3,self.args[0],self.args[1]
  467.  
  468. ENDPROC 2,self.args,NIL
  469.  
  470.                          /*for constant and variables, no precalculation is done..*/
  471. PROC enone(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  472.     IF fnc.precision=OUT_Integer    ;RETURN 0
  473.     ELSEIF fnc.precision=OUT_Float32;RETURN 0.
  474.     ELSEIF fnc.precision=OUT_Float64;RETURN dFloat(0,lr)
  475.     ENDIF
  476. ENDPROC
  477.  
  478. PROC econst(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  479.     IF fnc.precision=OUT_Float64
  480.         dCopy(lr,fnc.args)
  481.         RETURN lr
  482.     ENDIF
  483. ENDPROC fnc.args
  484.  
  485. PROC evar(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  486. DEF type
  487.     type:= fnc.args
  488.     IF fnc.precision=OUT_Integer
  489.         SELECT type
  490.         CASE VAR_x;RETURN x
  491.         CASE VAR_y;RETURN y
  492.         CASE CTE_e;RETURN 3   /*quite inaccurate... ;-)*/
  493.         CASE CTE_pi;RETURN 3
  494.         ENDSELECT
  495.     ELSEIF fnc.precision=OUT_Float32
  496.         SELECT type
  497.         CASE VAR_x;RETURN x!
  498.         CASE VAR_y;RETURN y!
  499.         CASE CTE_e;RETURN 2.71828183
  500.         CASE CTE_pi;RETURN 3.14159265
  501.         ENDSELECT
  502.     ELSEIF fnc.precision=OUT_Float64
  503.         SELECT type
  504.         CASE VAR_x;RETURN dFloat(x,lr)
  505.         CASE VAR_y;RETURN dFloat(y,lr)
  506.         CASE CTE_e;RETURN a2d('2.71828182846',lr)
  507.         CASE CTE_pi;RETURN dPi(lr)
  508.         ENDSELECT
  509.     ENDIF
  510. ENDPROC
  511. PROC eplus(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  512. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal
  513. DEF p1,p2
  514.     IF fnc.constant /*either return precalculated value or calculate it*/
  515.         IF x<>TRUE
  516.             IF fnc.precision=OUT_Float64 THEN
  517.                 RETURN dCopy(lr,fnc.value)
  518.             RETURN fnc.value
  519.         ENDIF
  520.         f1:=fnc.args[];f2:=fnc.args[1]
  521.         p1:=f1.type;p2:=f2.type
  522.         IF fnc.precision=OUT_Integer
  523.             fnc.value:= p1(x,y,lr,f1) + p2(x,y,lr,f2)
  524.             RETURN fnc.value
  525.         ELSEIF fnc.precision=OUT_Float32
  526.             fnc.value:= !p1(x,y,lr,f1)+p2(x,y,lr,f2)
  527.             RETURN fnc.value
  528.         ELSEIF fnc.precision=OUT_Float64
  529.             NEW lrl
  530.             dAdd(p1(x,y,lr,f1),p2(x,y,lrl,f2)) -> result put in lr
  531.             END lrl
  532.             RETURN dCopy(fnc.value,lr)
  533.         ENDIF
  534.     ELSE /*no precalculation involved*/
  535.         f1:=fnc.args[];f2:=fnc.args[1]
  536.         p1:=f1.type;p2:=f2.type
  537.         IF fnc.precision=OUT_Integer
  538.             RETURN p1(x,y,lr,f1) + p2(x,y,lr,f2)
  539.         ELSEIF fnc.precision=OUT_Float32
  540.             RETURN !p1(x,y,lr,f1)+p2(x,y,lr,f2)
  541.         ELSEIF fnc.precision=OUT_Float64
  542.             NEW lrl
  543.             dAdd(p1(x,y,lr,f1),p2(x,y,lrl,f2)) -> result put in lr
  544.             END lrl
  545.             RETURN lr
  546.         ENDIF
  547.     ENDIF
  548. ENDPROC
  549. PROC esubstr(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  550. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal
  551. DEF p1,p2
  552.     IF fnc.constant
  553.         IF x<>TRUE
  554.             IF fnc.precision=OUT_Float64 THEN
  555.                 RETURN dCopy(lr,fnc.value)
  556.             RETURN fnc.value
  557.         ENDIF
  558.         f1:=fnc.args[];f2:=fnc.args[1]
  559.         p1:=f1.type;p2:=f2.type
  560.         IF fnc.precision=OUT_Integer
  561.             fnc.value:= p1(x,y,lr,f1) - p2(x,y,lr,f2)
  562.             RETURN fnc.value
  563.         ELSEIF fnc.precision=OUT_Float32
  564.             fnc.value:= !p1(x,y,lr,f1) - p2(x,y,lr,f2)
  565.             RETURN fnc.value
  566.         ELSEIF fnc.precision=OUT_Float64
  567.             NEW lrl
  568.             dSub(p1(x,y,lr,f1),p2(x,y,lrl,f2)) -> result put in lr
  569.             END lrl
  570.             RETURN dCopy(fnc.value,lr)
  571.         ENDIF
  572.     ELSE
  573.         f1:=fnc.args[];f2:=fnc.args[1]
  574.         p1:=f1.type;p2:=f2.type
  575.         IF fnc.precision=OUT_Integer
  576.             RETURN p1(x,y,lr,f1) - p2(x,y,lr,f2)
  577.         ELSEIF fnc.precision=OUT_Float32
  578.             RETURN !p1(x,y,lr,f1) - p2(x,y,lr,f2)
  579.         ELSEIF fnc.precision=OUT_Float64
  580.             NEW lrl
  581.             dSub(p1(x,y,lr,f1),p2(x,y,lrl,f2)) -> result put in lr
  582.             END lrl
  583.             RETURN lr
  584.         ENDIF
  585.     ENDIF
  586. ENDPROC
  587. PROC emultiply(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  588. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal
  589. DEF p1,p2
  590.     IF fnc.constant
  591.         IF x<>TRUE
  592.             IF fnc.precision=OUT_Float64 THEN
  593.                 RETURN dCopy(lr,fnc.value)
  594.             RETURN fnc.value
  595.         ENDIF
  596.         f1:=fnc.args[];f2:=fnc.args[1]
  597.         p1:=f1.type;p2:=f2.type
  598.         IF fnc.precision=OUT_Integer
  599.             fnc.value:= Mul(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  600.             RETURN fnc.value
  601.         ELSEIF fnc.precision=OUT_Float32
  602.             fnc.value:= !p1(x,y,lr,f1) * p2(x,y,lr,f2)
  603.             RETURN fnc.value
  604.         ELSEIF fnc.precision=OUT_Float64
  605.             NEW lrl
  606.             dMul(p1(x,y,lr,f1),p2(x,y,lrl,f2))
  607.             END lrl
  608.             RETURN dCopy(fnc.value,lr)
  609.         ENDIF
  610.     ELSE
  611.         f1:=fnc.args[];f2:=fnc.args[1]
  612.         p1:=f1.type;p2:=f2.type
  613.         IF fnc.precision=OUT_Integer
  614.             RETURN Mul(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  615.         ELSEIF fnc.precision=OUT_Float32
  616.             RETURN !p1(x,y,lr,f1) * p2(x,y,lr,f2)
  617.         ELSEIF fnc.precision=OUT_Float64
  618.             NEW lrl
  619.             dMul(p1(x,y,lr,f1),p2(x,y,lrl,f2))
  620.             END lrl
  621.             RETURN lr
  622.         ENDIF
  623.     ENDIF
  624. ENDPROC
  625. PROC edivide(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  626. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal,k
  627. DEF p1,p2
  628.     IF fnc.constant
  629.         IF x<>TRUE
  630.             IF fnc.precision=OUT_Float64
  631.                 dCopy(lr,fnc.value);RETURN lr
  632.             ENDIF
  633.             RETURN fnc.value
  634.         ENDIF
  635.         f1:=fnc.args[];f2:=fnc.args[1]
  636.         p1:=f1.type;p2:=f2.type
  637.         IF fnc.precision=OUT_Integer
  638.             k:=p2(x,y,lr,f2)
  639.             IF k = 0
  640.                 fnc.value:=-123456
  641.                 RETURN fnc.value
  642.             ENDIF
  643.             fnc.value:= Div(p1(x,y,lr,f1) , k)
  644.             RETURN fnc.value
  645.         ELSEIF fnc.precision=OUT_Float32
  646.             k:=p2(x,y,lr,f2)
  647.             IF !k! = 0
  648.                 fnc.value:=-123456
  649.                 RETURN fnc.value
  650.             ENDIF
  651.             fnc.value:=!p1(x,y,lr,f1) / k
  652.             RETURN fnc.value
  653.         ELSEIF fnc.precision=OUT_Float64
  654.             NEW lrl
  655.             p2(x,y,lrl,f2)
  656.             IF dCompare(dFloat(0,lr),lrl)=0
  657.                 END lrl
  658.                 dFloat(-123456,lr)
  659.                 RETURN lr
  660.             ENDIF
  661.             dDiv(p1(x,y,lr,f1),lrl)
  662.             END lrl
  663.             dCopy(fnc.value,lr)
  664.             RETURN lr
  665.         ENDIF
  666.     ELSE
  667.         f1:=fnc.args[];f2:=fnc.args[1]
  668.         p1:=f1.type;p2:=f2.type
  669.         IF fnc.precision=OUT_Integer
  670.             k:=p2(x,y,lr,f2)
  671.             IF k = 0 THEN RETURN -123456
  672.             RETURN Div(p1(x,y,lr,f1) , k)
  673.         ELSEIF fnc.precision=OUT_Float32
  674.             k:=p2(x,y,lr,f2)
  675.             IF !k! = 0 THEN RETURN -123456
  676.             RETURN !p1(x,y,lr,f1) / k
  677.         ELSEIF fnc.precision=OUT_Float64
  678.             NEW lrl
  679.             lrl:=p2(x,y,lrl,f2)
  680.             IF dCompare(dFloat(0,lr),lrl)=0
  681.                 END lrl
  682.                 dFloat(-123456,lr)
  683.                 RETURN lr
  684.             ENDIF
  685.             dDiv(p1(x,y,lr,f1),lrl)
  686.             END lrl
  687.             RETURN lr
  688.         ENDIF
  689.     ENDIF
  690. ENDPROC
  691. PROC epower(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  692. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal
  693. DEF p1,p2
  694.     IF fnc.constant
  695.         IF x<>TRUE
  696.             IF fnc.precision=OUT_Float64
  697.                 dCopy(lr,fnc.value);RETURN lr
  698.             ENDIF
  699.             RETURN fnc.value
  700.         ENDIF
  701.         f1:=fnc.args[];f2:=fnc.args[1]
  702.         p1:=f1.type;p2:=f2.type
  703.         IF fnc.precision=OUT_Integer
  704.             fnc.value:= power(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  705.             RETURN fnc.value
  706.         ELSEIF fnc.precision=OUT_Float32
  707.             fnc.value:= Fpow(p2(x,y,lr,f2) , p1(x,y,lr,f1))
  708.             RETURN fnc.value
  709.         ELSEIF fnc.precision=OUT_Float64
  710.             NEW lrl
  711.             dPow(p1(x,y,lr,f1),p2(x,y,lrl,f2))
  712.             END lrl
  713.             dCopy(fnc.value,lr)
  714.             RETURN lr
  715.         ENDIF
  716.     ELSE
  717.         f1:=fnc.args[];f2:=fnc.args[1]
  718.         p1:=f1.type;p2:=f2.type
  719.         IF fnc.precision=OUT_Integer
  720.             RETURN power(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  721.         ELSEIF fnc.precision=OUT_Float32
  722.             RETURN Fpow(p2(x,y,lr,f2) , p1(x,y,lr,f1)) /*Hmm, Fpow(a,b) is b^a..*/
  723.         ELSEIF fnc.precision=OUT_Float64
  724.             NEW lrl
  725.             dPow(p1(x,y,lr,f1),p2(x,y,lrl,f2))
  726.             END lrl
  727.             RETURN lr
  728.         ENDIF
  729.     ENDIF
  730. ENDPROC
  731. PROC emod(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  732. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal
  733. DEF p1,p2
  734.     IF fnc.constant
  735.         IF x<>TRUE
  736.             IF fnc.precision=OUT_Float64 THEN
  737.                 RETURN dCopy(lr,fnc.value)
  738.             RETURN fnc.value
  739.         ENDIF
  740.         f1:=fnc.args[];f2:=fnc.args[1]
  741.         p1:=f1.type;p2:=f2.type
  742.         IF fnc.precision=OUT_Integer
  743.             lrl:=p2(x,y,lr,f2)
  744.             IF lrl > 0
  745.                 fnc.value:= Mod(p1(x,y,lr,f1) , lrl)
  746.             ELSE
  747.                 fnc.value:= 0
  748.             ENDIF
  749.             RETURN fnc.value
  750.         ELSEIF fnc.precision=OUT_Float32
  751.             fnc.value:= fMod(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  752.             RETURN fnc.value
  753.         ELSEIF fnc.precision=OUT_Float64
  754.             /*Pff.*/
  755.             RETURN dFloat(0,lr)
  756.         ENDIF
  757.     ELSE /*no precalculation involved*/
  758.         f1:=fnc.args[];f2:=fnc.args[1]
  759.         p1:=f1.type;p2:=f2.type
  760.         IF fnc.precision=OUT_Integer
  761.             lrl:=p2(x,y,lr,f2)
  762.             IF lrl > 0
  763.                 RETURN Mod(p1(x,y,lr,f1) , lrl)
  764.             ELSE
  765.                 RETURN 0
  766.             ENDIF
  767.         ELSEIF fnc.precision=OUT_Float32
  768.             RETURN fMod(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  769.         ELSEIF fnc.precision=OUT_Float64
  770.             RETURN dFloat(0,lr)
  771.         ENDIF
  772.     ENDIF
  773. ENDPROC
  774. PROC fMod(a,b) IS !a-(!Ffloor(!a/b)*b)
  775.  
  776. PROC emax(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  777. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal
  778. DEF p1,p2
  779.     IF fnc.constant
  780.         IF x<>TRUE
  781.             IF fnc.precision=OUT_Float64 THEN
  782.                 RETURN dCopy(lr,fnc.value)
  783.             RETURN fnc.value
  784.         ENDIF
  785.         f1:=fnc.args[];f2:=fnc.args[1]
  786.         p1:=f1.type;p2:=f2.type
  787.         IF fnc.precision=OUT_Integer
  788.             fnc.value:= Max(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  789.             RETURN fnc.value
  790.         ELSEIF fnc.precision=OUT_Float32
  791.             fnc.value:= fMax(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  792.             RETURN fnc.value
  793.         ELSEIF fnc.precision=OUT_Float64
  794.             NEW lrl
  795.             dCopy(fnc.value,dMax(p1(x,y,lr,f1) , p2(x,y,lrl,f2)))
  796.             END lrl
  797.             RETURN dCopy(fnc.value,lr)
  798.         ENDIF
  799.     ELSE
  800.         f1:=fnc.args[];f2:=fnc.args[1]
  801.         p1:=f1.type;p2:=f2.type
  802.         IF fnc.precision=OUT_Integer
  803.             RETURN Max(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  804.         ELSEIF fnc.precision=OUT_Float32
  805.             RETURN fMax(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  806.         ELSEIF fnc.precision=OUT_Float64
  807.             NEW lrl
  808.             dCopy(lr,dMax(p1(x,y,lr,f1) , p2(x,y,lrl,f2)))
  809.             END lrl
  810.             RETURN lr
  811.         ENDIF
  812.     ENDIF
  813. ENDPROC
  814. PROC fMax(a,b)
  815.     IF !a<b THEN RETURN b ELSE RETURN a
  816. ENDPROC
  817. PROC dMax(a,b)
  818.     IF dCompare(a,b)=-1 THEN RETURN b ELSE RETURN a
  819. ENDPROC
  820.  
  821. PROC emin(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  822. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal
  823. DEF p1,p2
  824.     IF fnc.constant
  825.         IF x<>TRUE
  826.             IF fnc.precision=OUT_Float64 THEN
  827.                 RETURN dCopy(lr,fnc.value)
  828.             RETURN fnc.value
  829.         ENDIF
  830.         f1:=fnc.args[];f2:=fnc.args[1]
  831.         p1:=f1.type;p2:=f2.type
  832.         IF fnc.precision=OUT_Integer
  833.             fnc.value:= Min(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  834.             RETURN fnc.value
  835.         ELSEIF fnc.precision=OUT_Float32
  836.             fnc.value:= fMin(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  837.             RETURN fnc.value
  838.         ELSEIF fnc.precision=OUT_Float64
  839.             NEW lrl
  840.             dCopy(fnc.value,dMin(p1(x,y,lr,f1) , p2(x,y,lrl,f2)))
  841.             END lrl
  842.             RETURN dCopy(fnc.value,lr)
  843.         ENDIF
  844.     ELSE
  845.         f1:=fnc.args[];f2:=fnc.args[1]
  846.         p1:=f1.type;p2:=f2.type
  847.         IF fnc.precision=OUT_Integer
  848.             RETURN Min(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  849.         ELSEIF fnc.precision=OUT_Float32
  850.             RETURN fMin(p1(x,y,lr,f1) , p2(x,y,lr,f2))
  851.         ELSEIF fnc.precision=OUT_Float64
  852.             NEW lrl
  853.             dCopy(lr,dMin(p1(x,y,lr,f1) , p2(x,y,lrl,f2)))
  854.             END lrl
  855.             RETURN lr
  856.         ENDIF
  857.     ENDIF
  858. ENDPROC
  859. PROC fMin(a,b)
  860.     IF !a>b THEN RETURN b ELSE RETURN a
  861. ENDPROC
  862. PROC dMin(a,b)
  863.     IF dCompare(a,b)=1 THEN RETURN b ELSE RETURN a
  864. ENDPROC
  865.  
  866.  
  867. PROC esin(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  868. DEF f1:PTR TO function
  869. DEF p1
  870.     IF fnc.constant
  871.         IF x<>TRUE
  872.             IF fnc.precision=OUT_Float64
  873.                 dCopy(lr,fnc.value);RETURN lr
  874.             ENDIF
  875.             RETURN fnc.value
  876.         ENDIF
  877.         f1:=fnc.args
  878.         p1:=f1.type
  879.         IF fnc.precision=OUT_Integer
  880.             fnc.value:=0;RETURN 0 -> (Would be quite silly to compute trig functions with integers)
  881.         ELSEIF fnc.precision=OUT_Float32
  882.             fnc.value:=Fsin(p1(x,y,lr,f1))
  883.             RETURN fnc.value
  884.         ELSEIF fnc.precision=OUT_Float64
  885.             dSin(p1(x,y,lr,f1))
  886.             dCopy(fnc.value,lr)
  887.             RETURN lr
  888.         ENDIF
  889.     ELSE
  890.         f1:=fnc.args
  891.         p1:=f1.type
  892.         IF fnc.precision=OUT_Integer;RETURN 0
  893.         ELSEIF fnc.precision=OUT_Float32
  894.             RETURN Fsin(p1(x,y,lr,f1))
  895.         ELSEIF fnc.precision=OUT_Float64
  896.             RETURN dSin(p1(x,y,lr,f1))
  897.         ENDIF
  898.     ENDIF
  899. ENDPROC
  900. PROC ecos(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  901. DEF f1:PTR TO function
  902. DEF p1
  903.     IF fnc.constant
  904.         IF x<>TRUE
  905.             IF fnc.precision=OUT_Float64
  906.                 dCopy(lr,fnc.value);RETURN lr
  907.             ENDIF
  908.             RETURN fnc.value
  909.         ENDIF
  910.         f1:=fnc.args
  911.         p1:=f1.type
  912.         IF fnc.precision=OUT_Integer
  913.             fnc.value:=0;RETURN 0
  914.         ELSEIF fnc.precision=OUT_Float32
  915.             fnc.value:= Fcos(p1(x,y,lr,f1))
  916.             RETURN fnc.value
  917.         ELSEIF fnc.precision=OUT_Float64
  918.             dCos(p1(x,y,lr,f1))
  919.             dCopy(fnc.value,lr)
  920.             RETURN lr
  921.         ENDIF
  922.     ELSE
  923.         f1:=fnc.args
  924.         p1:=f1.type
  925.         IF fnc.precision=OUT_Integer;RETURN 0
  926.         ELSEIF fnc.precision=OUT_Float32
  927.             RETURN Fcos(p1(x,y,lr,f1))
  928.         ELSEIF fnc.precision=OUT_Float64
  929.             RETURN dCos(p1(x,y,lr,f1))
  930.         ENDIF
  931.     ENDIF
  932. ENDPROC
  933. PROC etan(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  934. DEF f1:PTR TO function
  935. DEF p1
  936.     IF fnc.constant
  937.         IF x<>TRUE
  938.             IF fnc.precision=OUT_Float64
  939.                 dCopy(lr,fnc.value);RETURN lr
  940.             ENDIF
  941.             RETURN fnc.value
  942.         ENDIF
  943.         f1:=fnc.args
  944.         p1:=f1.type
  945.         IF fnc.precision=OUT_Integer
  946.             fnc.value:=0;RETURN 0
  947.         ELSEIF fnc.precision=OUT_Float32
  948.             fnc.value:= Ftan(p1(x,y,lr,f1))
  949.             RETURN fnc.value
  950.         ELSEIF fnc.precision=OUT_Float64
  951.             dTan(p1(x,y,lr,f1))
  952.             dCopy(fnc.value,lr)
  953.             RETURN lr
  954.         ENDIF
  955.     ELSE
  956.         f1:=fnc.args
  957.         p1:=f1.type
  958.         IF fnc.precision=OUT_Integer;RETURN 0
  959.         ELSEIF fnc.precision=OUT_Float32
  960.             RETURN Ftan(p1(x,y,lr,f1))
  961.         ELSEIF fnc.precision=OUT_Float64
  962.             RETURN dTan(p1(x,y,lr,f1))
  963.         ENDIF
  964.     ENDIF
  965. ENDPROC
  966. PROC easin(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  967. DEF f1:PTR TO function
  968. DEF p1
  969.     IF fnc.constant
  970.         IF x<>TRUE
  971.             IF fnc.precision=OUT_Float64
  972.                 dCopy(lr,fnc.value);RETURN lr
  973.             ENDIF
  974.             RETURN fnc.value
  975.         ENDIF
  976.         f1:=fnc.args
  977.         p1:=f1.type
  978.         IF fnc.precision=OUT_Integer
  979.             fnc.value:=0;RETURN 0
  980.         ELSEIF fnc.precision=OUT_Float32
  981.             fnc.value:= Fasin(p1(x,y,lr,f1))
  982.             RETURN fnc.value
  983.         ELSEIF fnc.precision=OUT_Float64
  984.             dASin(p1(x,y,lr,f1))
  985.             dCopy(fnc.value,lr)
  986.             RETURN lr
  987.         ENDIF
  988.     ELSE
  989.         f1:=fnc.args
  990.         p1:=f1.type
  991.         IF fnc.precision=OUT_Integer;RETURN 0
  992.         ELSEIF fnc.precision=OUT_Float32
  993.             RETURN Fasin(p1(x,y,lr,f1))
  994.         ELSEIF fnc.precision=OUT_Float64
  995.             RETURN dASin(p1(x,y,lr,f1))
  996.         ENDIF
  997.     ENDIF
  998. ENDPROC
  999. PROC eacos(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  1000. DEF f1:PTR TO function
  1001. DEF p1
  1002.     IF fnc.constant
  1003.         IF x<>TRUE
  1004.             IF fnc.precision=OUT_Float64
  1005.                 dCopy(lr,fnc.value);RETURN lr
  1006.             ENDIF
  1007.             RETURN fnc.value
  1008.         ENDIF
  1009.         f1:=fnc.args
  1010.         p1:=f1.type
  1011.         IF fnc.precision=OUT_Integer
  1012.             fnc.value:=0;RETURN 0
  1013.         ELSEIF fnc.precision=OUT_Float32
  1014.             fnc.value:= Facos(p1(x,y,lr,f1))
  1015.             RETURN fnc.value
  1016.         ELSEIF fnc.precision=OUT_Float64
  1017.             dACos(p1(x,y,lr,f1))
  1018.             dCopy(fnc.value,lr)
  1019.             RETURN lr
  1020.         ENDIF
  1021.     ELSE
  1022.         f1:=fnc.args
  1023.         p1:=f1.type
  1024.         IF fnc.precision=OUT_Integer;RETURN 0
  1025.         ELSEIF fnc.precision=OUT_Float32
  1026.             RETURN Facos(p1(x,y,lr,f1))
  1027.         ELSEIF fnc.precision=OUT_Float64
  1028.             RETURN dACos(p1(x,y,lr,f1))
  1029.         ENDIF
  1030.     ENDIF
  1031. ENDPROC
  1032. PROC eatan(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  1033. DEF f1:PTR TO function
  1034. DEF p1
  1035.     IF fnc.constant
  1036.         IF x<>TRUE
  1037.             IF fnc.precision=OUT_Float64
  1038.                 dCopy(lr,fnc.value);RETURN lr
  1039.             ENDIF
  1040.             RETURN fnc.value
  1041.         ENDIF
  1042.         f1:=fnc.args
  1043.         p1:=f1.type
  1044.         IF fnc.precision=OUT_Integer
  1045.             fnc.value:=0;RETURN 0
  1046.         ELSEIF fnc.precision=OUT_Float32
  1047.             fnc.value:= Fatan(p1(x,y,lr,f1))
  1048.             RETURN fnc.value
  1049.         ELSEIF fnc.precision=OUT_Float64
  1050.             dATan(p1(x,y,lr,f1))
  1051.             dCopy(fnc.value,lr)
  1052.             RETURN lr
  1053.         ENDIF
  1054.     ELSE
  1055.         f1:=fnc.args
  1056.         p1:=f1.type
  1057.         IF fnc.precision=OUT_Integer;RETURN 0
  1058.         ELSEIF fnc.precision=OUT_Float32
  1059.             RETURN Fatan(p1(x,y,lr,f1))
  1060.         ELSEIF fnc.precision=OUT_Float64
  1061.             RETURN dATan(p1(x,y,lr,f1))
  1062.         ENDIF
  1063.     ENDIF
  1064. ENDPROC
  1065.  
  1066. EXPORT PROC kmod(a,b)
  1067.     IF a >= 0 THEN RETURN Mod(a,b)
  1068. ENDPROC Mod(a,b)+b
  1069.  
  1070. PROC ered(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  1071. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal
  1072. DEF p1,p2,xx,yy,data:PTR TO planeFunc_data
  1073.     f1:=fnc.args[1];f2:=fnc.args[2]
  1074.     p1:=f1.type;    p2:=f2.type
  1075.     xx:=p1(x,y,lr,f1)
  1076.     IF fnc.precision=OUT_Float64 THEN
  1077.         NEW lrl
  1078.     yy:=p2(x,y,lrl,f2)
  1079.     data:=fnc.args[]
  1080.     IF fnc.precision=OUT_Integer
  1081.         RETURN Shr(ReadRGBPixel(data.rp,kmod(xx,data.width),kmod(yy,data.height)),16)
  1082.     ELSEIF fnc.precision=OUT_Float32
  1083.         RETURN Shr(ReadRGBPixel(data.rp,kmod(!xx!,data.width),kmod(!yy!,data.height)),16)!
  1084.     ELSEIF fnc.precision=OUT_Float64
  1085.         xx:=Shr(ReadRGBPixel(data.rp,kmod(dFix(lr),data.width),kmod(dFix(lrl),data.height)),16)
  1086.         END lrl
  1087.         RETURN dFloat(xx,lr)
  1088.     ENDIF
  1089. ENDPROC
  1090. PROC egreen(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  1091. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal
  1092. DEF p1,p2,xx,yy,data:PTR TO planeFunc_data
  1093.     f1:=fnc.args[1];f2:=fnc.args[2]
  1094.     p1:=f1.type;    p2:=f2.type
  1095.     xx:=p1(x,y,lr,f1)
  1096.     IF fnc.precision=OUT_Float64 THEN
  1097.         NEW lrl
  1098.     yy:=p2(x,y,lrl,f2)
  1099.     data:=fnc.args[]
  1100.     IF fnc.precision=OUT_Integer
  1101.         RETURN Shr(ReadRGBPixel(data.rp,kmod(xx,data.width),kmod(yy,data.height)) AND $FF00,8)
  1102.     ELSEIF fnc.precision=OUT_Float32
  1103.         RETURN Shr(ReadRGBPixel(data.rp,kmod(!xx!,data.width),kmod(!yy!,data.height)) AND $FF00,8)!
  1104.     ELSEIF fnc.precision=OUT_Float64
  1105.         xx:=Shr(ReadRGBPixel(data.rp,kmod(dFix(lr),data.width),kmod(dFix(lrl),data.height)) AND $FF00,8)
  1106.         END lrl
  1107.         RETURN dFloat(xx,lr)
  1108.     ENDIF
  1109. ENDPROC
  1110. PROC eblue(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  1111. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal
  1112. DEF p1,p2,xx,yy,data:PTR TO planeFunc_data
  1113.     f1:=fnc.args[1];f2:=fnc.args[2]
  1114.     p1:=f1.type;    p2:=f2.type
  1115.     xx:=p1(x,y,lr,f1)
  1116.     IF fnc.precision=OUT_Float64 THEN
  1117.         NEW lrl
  1118.     yy:=p2(x,y,lrl,f2)
  1119.     data:=fnc.args[]
  1120.     IF fnc.precision=OUT_Integer
  1121.         RETURN ReadRGBPixel(data.rp,kmod(xx,data.width),kmod(yy,data.height)) AND $FF
  1122.     ELSEIF fnc.precision=OUT_Float32
  1123.         RETURN (ReadRGBPixel(data.rp,kmod(!xx!,data.width),kmod(!yy!,data.height)) AND $FF)!
  1124.     ELSEIF fnc.precision=OUT_Float64
  1125.         xx:=ReadRGBPixel(data.rp,kmod(dFix(lr),data.width),kmod(dFix(lrl),data.height)) AND $FF
  1126.         END lrl
  1127.         RETURN dFloat(xx,lr)
  1128.     ENDIF
  1129. ENDPROC
  1130.                  /*Picasso 96 version of Inter-Referencing functions... */
  1131. PROC pred(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  1132. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal
  1133. DEF p1,p2,xx,yy,data:PTR TO planeFunc_data
  1134.     f1:=fnc.args[1];f2:=fnc.args[2]
  1135.     p1:=f1.type;    p2:=f2.type
  1136.     xx:=p1(x,y,lr,f1)
  1137.     IF fnc.precision=OUT_Float64 THEN
  1138.         NEW lrl
  1139.     yy:=p2(x,y,lrl,f2)
  1140.     data:=fnc.args[]
  1141.     IF fnc.precision=OUT_Integer
  1142.         p1:=Pi96ReadPixel(data.rp,kmod(xx,data.width),kmod(yy,data.height))
  1143.         RETURN Shr(p1,16)
  1144.     ELSEIF fnc.precision=OUT_Float32
  1145.         RETURN Shr(Pi96ReadPixel(data.rp,kmod(!xx!,data.width),kmod(!yy!,data.height)),16)!
  1146.     ELSEIF fnc.precision=OUT_Float64
  1147.         xx:=Shr(Pi96ReadPixel(data.rp,kmod(dFix(lr),data.width),kmod(dFix(lrl),data.height)),16)
  1148.         END lrl
  1149.         RETURN dFloat(xx,lr)
  1150.     ENDIF
  1151. ENDPROC
  1152. PROC pgreen(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  1153. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal
  1154. DEF p1,p2,xx,yy,data:PTR TO planeFunc_data
  1155.     f1:=fnc.args[1];f2:=fnc.args[2]
  1156.     p1:=f1.type;    p2:=f2.type
  1157.     xx:=p1(x,y,lr,f1)
  1158.     IF fnc.precision=OUT_Float64 THEN
  1159.         NEW lrl
  1160.     yy:=p2(x,y,lrl,f2)
  1161.     data:=fnc.args[]
  1162.     IF fnc.precision=OUT_Integer
  1163.         RETURN Shr(Pi96ReadPixel(data.rp,kmod(xx,data.width),kmod(yy,data.height)) AND $FF00,8)
  1164.     ELSEIF fnc.precision=OUT_Float32
  1165.         RETURN Shr(Pi96ReadPixel(data.rp,kmod(!xx!,data.width),kmod(!yy!,data.height)) AND $FF00,8)!
  1166.     ELSEIF fnc.precision=OUT_Float64
  1167.         xx:=Shr(Pi96ReadPixel(data.rp,kmod(dFix(lr),data.width),kmod(dFix(lrl),data.height)) AND $FF00,8)
  1168.         END lrl
  1169.         RETURN dFloat(xx,lr)
  1170.     ENDIF
  1171. ENDPROC
  1172. PROC pblue(x,y,lr:PTR TO longreal,fnc:PTR TO function)
  1173. DEF f1:PTR TO function,f2:PTR TO function,lrl:PTR TO longreal
  1174. DEF p1,p2,xx,yy,data:PTR TO planeFunc_data
  1175.     f1:=fnc.args[1];f2:=fnc.args[2]
  1176.     p1:=f1.type;    p2:=f2.type
  1177.     xx:=p1(x,y,lr,f1)
  1178.     IF fnc.precision=OUT_Float64 THEN
  1179.         NEW lrl
  1180.     yy:=p2(x,y,lrl,f2)
  1181.     data:=fnc.args[]
  1182.     IF fnc.precision=OUT_Integer
  1183.         RETURN Pi96ReadPixel(data.rp,kmod(xx,data.width),kmod(yy,data.height)) AND $FF
  1184.     ELSEIF fnc.precision=OUT_Float32
  1185.         RETURN (Pi96ReadPixel(data.rp,kmod(!xx!,data.width),kmod(!yy!,data.height)) AND $FF)!
  1186.     ELSEIF fnc.precision=OUT_Float64
  1187.         xx:=Pi96ReadPixel(data.rp,kmod(dFix(lr),data.width),kmod(dFix(lrl),data.height)) AND $FF
  1188.         END lrl
  1189.         RETURN dFloat(xx,lr)
  1190.     ENDIF
  1191. ENDPROC
  1192.  
  1193. PROC power(base,exp)
  1194. DEF result
  1195.     IF exp = 0 THEN RETURN 1
  1196.     result:=base
  1197.     WHILE exp > 1
  1198.         result:=Mul(result,base)
  1199.         exp--
  1200.     ENDWHILE
  1201. ENDPROC result
  1202.  
  1203. PROC create(precision) OF function
  1204. DEF lr:PTR TO longreal
  1205.     self.precision:=precision
  1206.     self.type:=farray[FTYPE_None]
  1207.     IF precision=OUT_Float64
  1208.         NEW lr
  1209.         self.value:=lr
  1210.         dFloat(0,lr)
  1211.     ENDIF
  1212. ENDPROC 1
  1213.  
  1214. PROC proc() OF function IS self.type /* a method and no direct access, so that
  1215.                                         the user can only read the attribute... */
  1216. PROC end() OF function
  1217. DEF k:PTR TO LONG,lr:PTR TO longreal
  1218.     IF self.precision=OUT_Float64 AND (self.nofree=FALSE)
  1219.         lr:=self.value
  1220.         END lr
  1221.         IF self.type=farray[FTYPE_Constant]
  1222.             lr:=self.args
  1223.             END lr
  1224.         ENDIF
  1225.     ENDIF
  1226.  
  1227.     IF self.type <= farray[FTYPE_Variable] THEN RETURN
  1228.     IF (self.type<=farray[FTYPE_Min])
  1229.  
  1230.         endf(self.args[0])
  1231.         endf(self.args[1])
  1232.         k:=self.args
  1233.         END k[2]
  1234.     ELSEIF self.type >= farray[FTYPE_Red]
  1235.         endf(self.args[1])
  1236.         endf(self.args[2])
  1237.         k:=self.args
  1238.         END k[3]
  1239.     ELSE
  1240.         endf(self.args)
  1241.     ENDIF
  1242.     self.type:=farray[FTYPE_None] -> So that if this function is end-ed another time, no harm will be done..
  1243. ENDPROC
  1244.  
  1245. PROC endf(fun:PTR TO function)
  1246.     IF fun > 0 THEN END fun
  1247. ENDPROC
  1248.